1 Preface

Load R packages and functions

library(tidyverse)
#> Warning: package 'tidyverse' was built under R version 4.2.1
#> ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
#> ✔ ggplot2 3.3.6      ✔ purrr   0.3.4 
#> ✔ tibble  3.1.8      ✔ dplyr   1.0.10
#> ✔ tidyr   1.2.1      ✔ stringr 1.4.1 
#> ✔ readr   2.1.2      ✔ forcats 0.5.2
#> Warning: package 'ggplot2' was built under R version 4.2.1
#> Warning: package 'tibble' was built under R version 4.2.1
#> Warning: package 'tidyr' was built under R version 4.2.1
#> Warning: package 'readr' was built under R version 4.2.1
#> Warning: package 'dplyr' was built under R version 4.2.1
#> Warning: package 'stringr' was built under R version 4.2.1
#> Warning: package 'forcats' was built under R version 4.2.1
#> ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
#> ✖ dplyr::filter() masks stats::filter()
#> ✖ dplyr::lag()    masks stats::lag()
# install.packages("plyr")
library(plyr)
#> Warning: package 'plyr' was built under R version 4.2.1
#> ------------------------------------------------------------------------------
#> You have loaded plyr after dplyr - this is likely to cause problems.
#> If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
#> library(plyr); library(dplyr)
#> ------------------------------------------------------------------------------
#> 
#> Attaching package: 'plyr'
#> 
#> The following objects are masked from 'package:dplyr':
#> 
#>     arrange, count, desc, failwith, id, mutate, rename, summarise,
#>     summarize
#> 
#> The following object is masked from 'package:purrr':
#> 
#>     compact
# devtools::install_github("pavlakrotka/NCC@v1.0")
library(NCC)
#> Registered S3 methods overwritten by 'registry':
#>   method               from 
#>   print.registry_field proxy
#>   print.registry_entry proxy
#> Warning: package 'memoise' was built under R version 4.2.1
source("C:/Users/mbofi/Dropbox/CeMSIIS/GitHub/Allocation/case-study/aux_functions.R")

2 Case Study

We illustrate the optimal allocations in platform trials by means of a phase II placebo-controlled trial in primary hypercholesterolemia.

In the original study, patients were randomised to the three arms following 1:1:1. In what follows, we used this trial as a motivating study to describe how the patients would have been allocated to the different arms and periods using three allocation strategies -namely, equal allocation (1:…:1), square root of \(k\) (1:…:\(\sqrt(k)\)) and the proposed optimal allocations-, and according to three different trial designs:

  1. Design with one period only (that is, multi-arm design)
  2. Design with two periods (arm 2 starts later, but arms 1 and 2 finish at the same time)
  3. Design with three periods (arm 2 starts later and finishes after arm 1 does)

We also compare the power and type 1 error by means of simulations where we considered the estimated mean in the control arm in the original study. For comparative purposes, in this case study, we suppose total sample size of \(N=80\) and equal effect sizes for arms 1 and 2 as compared to control. Also, we considered a trial using concurrent controls only.

# means
mean_control = 17.3/3.5
mean_arm1 = 66.2/3.5
mean_arm2 = 72.3/3.5

2.1 Design 1: multi-arm design

In this case, we consider a design with one period only. The scheme of the trial over time is:

db1_one = sim_designs(r1=1,r2=0,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="one")
db1_sqrt = sim_designs(r1=1,r2=0,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="sqrt")
db1_opt = sim_designs(r1=1,r2=0,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="opt")
plot_trial(db1_one$data$treatment) 
Figure: Design 1: multi-arm design.

Figure: Design 1: multi-arm design.

# sample sizes
db1_one$ss
#>      [,1] [,2] [,3]
#> [1,]   27    0    0
#> [2,]   27    0    0
#> [3,]   27    0    0
db1_sqrt$ss
#>      [,1] [,2] [,3]
#> [1,]   23    0    0
#> [2,]   23    0    0
#> [3,]   33    0    0
db1_opt$ss
#>      [,1] [,2] [,3]
#> [1,]   23    0    0
#> [2,]   23    0    0
#> [3,]   33    0    0

db1_one_ss <- data.frame(arms=c("A1","A2","C"),db1_one$ss, c(sum(db1_one$ss[1,]),sum(db1_one$ss[2,]),sum(db1_one$ss[3,])))
db1_sqrt_ss <- data.frame(arms=c("A1","A2","C"), db1_sqrt$ss, c(sum(db1_sqrt$ss[1,]),sum(db1_sqrt$ss[2,]),sum(db1_sqrt$ss[3,])))
db1_opt_ss <- data.frame(arms=c("A1","A2","C"), db1_opt$ss, c(sum(db1_opt$ss[1,]),sum(db1_opt$ss[2,]),sum(db1_opt$ss[3,])))

The sample sizes per arm and period according to the allocation strategies are the following:

knitr::kable(db1_one_ss, format = "markdown", caption = c("Sample sizes per period and arm (1:1)"), col.names = c("Arms", "Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (1:1)
Arms Period 1 Period 2 Period 3 Total per arm
A1 27 0 0 27
A2 27 0 0 27
C 27 0 0 27
knitr::kable(db1_sqrt_ss, format = "markdown", caption = c("Sample sizes per period and arm (sqrt(k)-rule)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (sqrt(k)-rule)
Arms Period 1 Period 2 Period 3 Total per arm
A1 23 0 0 23
A2 23 0 0 23
C 33 0 0 33
knitr::kable(db1_opt_ss, format = "markdown", caption = c("Sample sizes per period and arm (optimal allocations)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (optimal allocations)
Arms Period 1 Period 2 Period 3 Total per arm
A1 23 0 0 23
A2 23 0 0 23
C 33 0 0 33

Comparing groups when using 1:1 allocation

res1_one = do.call(rbind.data.frame, models_cc(data = db1_one$data) )
res1_one$width_ci = res1_one$upper_ci  - res1_one$lower_ci  
knitr::kable(res1_one, format = "markdown") 
p_val treat_effect lower_ci upper_ci reject_h0 arm width_ci
0 13.98892 11.35758 16.62025 TRUE a1 5.262667
0 19.85173 17.40629 22.29717 TRUE a2 4.890888

Comparing groups when using \(\sqrt(k)\)-allocation (and thus optimal allocations)

res1_opt = do.call(rbind.data.frame, models_cc(data = db1_opt$data) )
res1_opt$width_ci = res1_opt$upper_ci  - res1_opt$lower_ci  
knitr::kable(res1_opt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm width_ci
0 12.17273 9.83023 14.51523 TRUE a1 4.684997
0 14.97292 12.36985 17.57600 TRUE a2 5.206150

2.2 Design 2: two-period design

N = 80
N1 = round(N/4)
N2 = round(N-N1)
c(N1,N2,N-N1-N2)
#> [1] 20 60  0

In this case, we consider a design with two periods. The scheme of the trial over time is:

db2_one=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="one")
db2_sqrt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="sqrt")
db2_opt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="opt")
plot_trial(db2_one$data$treatment) 
Figure: Design 2: two-period design.

Figure: Design 2: two-period design.

# sample sizes
db2_one$ss
#>      [,1] [,2] [,3]
#> [1,]    0   20    0
#> [2,]   10   20    0
#> [3,]   10   20    0
db2_sqrt$ss
#>      [,1] [,2] [,3]
#> [1,]    0   18    0
#> [2,]   10   18    0
#> [3,]   10   25    0
db2_opt$ss
#>      [,1] [,2] [,3]
#> [1,]    0   24    0
#> [2,]   10   10    0
#> [3,]   10   26    0

db2_one_ss <- data.frame(arms=c("A1","A2","C"),db2_one$ss, c(sum(db2_one$ss[1,]),sum(db2_one$ss[2,]),sum(db2_one$ss[3,])))
db2_sqrt_ss <- data.frame(arms=c("A1","A2","C"), db2_sqrt$ss, c(sum(db2_sqrt$ss[1,]),sum(db2_sqrt$ss[2,]),sum(db2_sqrt$ss[3,])))
db2_opt_ss <- data.frame(arms=c("A1","A2","C"), db2_opt$ss, c(sum(db2_opt$ss[1,]),sum(db2_opt$ss[2,]),sum(db2_opt$ss[3,])))

The sample sizes per arm and period according to the allocation strategies are the following:

knitr::kable(db2_one_ss, format = "markdown", caption = c("Sample sizes per period and arm (1:1)"), col.names = c("Arms", "Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (1:1)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 20 0 20
A2 10 20 0 30
C 10 20 0 30
knitr::kable(db2_sqrt_ss, format = "markdown", caption = c("Sample sizes per period and arm (sqrt(k)-rule)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (sqrt(k)-rule)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 18 0 18
A2 10 18 0 28
C 10 25 0 35
knitr::kable(db2_opt_ss, format = "markdown", caption = c("Sample sizes per period and arm (optimal allocations)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (optimal allocations)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 24 0 24
A2 10 10 0 20
C 10 26 0 36

Comparing groups when using 1:1 allocation

res2_one = do.call(rbind.data.frame, models_cc(data = db2_one$data) )
res2_one$width_ci = res2_one$upper_ci  - res2_one$lower_ci  
knitr::kable(res2_one, format = "markdown") 
p_val treat_effect lower_ci upper_ci reject_h0 arm width_ci
0 14.20840 12.54252 15.87429 TRUE a1 3.331769
0 16.63623 14.24960 19.02287 TRUE a2 4.773272

Comparing groups when using \(\sqrt(k)\)-allocation

res2_sqrt = do.call(rbind.data.frame, models_cc(data = db2_sqrt$data) )
res2_sqrt$width_ci = res2_sqrt$upper_ci  - res2_sqrt$lower_ci  
knitr::kable(res2_sqrt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm width_ci
0 13.50474 11.94184 15.06765 TRUE a1 3.125809
0 15.69804 13.35320 18.04288 TRUE a2 4.689681

Comparing groups when using the optimal allocations

res2_opt = do.call(rbind.data.frame, models_cc(data = db2_opt$data) )
res2_opt$width_ci = res2_opt$upper_ci  - res2_opt$lower_ci  
knitr::kable(res2_opt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm width_ci
0 14.19902 12.55555 15.84249 TRUE a1 3.286938
0 16.03787 13.99688 18.07885 TRUE a2 4.081974

2.3 Design 3: three-period design

Suppose now a design with three periods with \(N_1=31\) and consider two situations for \(N_2\), say \(N_2=N-N_1\) and \(N_2= N_1/2\).

2.3.1 Trial with equal allocation rates for periods 1 and 3

Suppose now that the size of the periods are:

N1 = round(N/3)
N2 = round(N-2*N1)
c(N, N1, N2, N-N1-N2)
#> [1] 80 27 26 27

Note that in this case the duration of periods 1 and 3 is the same, leading to a symmetrical trial. Below we illustrate the scheme of the trial over time.


db3_one=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="one")
db3_sqrt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="sqrt")
db3_opt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="opt")

plot_trial(db3_opt$data$treatment) 
Design 3: three-period design (r1=r3).

Design 3: three-period design (r1=r3).


# sample sizes
db3_one$ss
#>      [,1] [,2] [,3]
#> [1,]    0    9   13
#> [2,]   14    9    0
#> [3,]   14    9   13
db3_sqrt$ss
#>      [,1] [,2] [,3]
#> [1,]    0    8   13
#> [2,]   14    8    0
#> [3,]   14   11   13
db3_opt$ss
#>      [,1] [,2] [,3]
#> [1,]    0    8   13
#> [2,]   14    8    0
#> [3,]   14   11   13

db3_one_ss <- data.frame(arms=c("A1","A2","C"),db3_one$ss, c(sum(db3_one$ss[1,]),sum(db3_one$ss[2,]),sum(db3_one$ss[3,])))
db3_sqrt_ss <- data.frame(arms=c("A1","A2","C"), db3_sqrt$ss, c(sum(db3_sqrt$ss[1,]),sum(db3_sqrt$ss[2,]),sum(db3_sqrt$ss[3,])))
db3_opt_ss <- data.frame(arms=c("A1","A2","C"), db3_opt$ss, c(sum(db3_opt$ss[1,]),sum(db3_opt$ss[2,]),sum(db3_opt$ss[3,])))

The sample sizes per arm and period according to the allocation strategies are the following:

knitr::kable(db3_one_ss, format = "markdown", caption = c("Sample sizes per period and arm (1:1)"), col.names = c("Arms", "Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (1:1)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 9 13 22
A2 14 9 0 23
C 14 9 13 36
knitr::kable(db3_sqrt_ss, format = "markdown", caption = c("Sample sizes per period and arm (sqrt(k)-rule)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (sqrt(k)-rule)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 8 13 21
A2 14 8 0 22
C 14 11 13 38
knitr::kable(db3_opt_ss, format = "markdown", caption = c("Sample sizes per period and arm (optimal allocations)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (optimal allocations)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 8 13 21
A2 14 8 0 22
C 14 11 13 38

Comparing groups when using 1:1 allocation

res3_one = do.call(rbind.data.frame, models_cc(data = db3_one$data) )
res3_one$width_ci = res3_one$upper_ci  - res3_one$lower_ci 
knitr::kable(res3_one, format = "markdown") 
p_val treat_effect lower_ci upper_ci reject_h0 arm width_ci
0 14.64743 13.55563 15.73923 TRUE a1 2.183594
0 16.28091 15.15455 17.40726 TRUE a2 2.252712

Comparing groups when using \(\sqrt(k)\)-allocation

res3_sqrt = do.call(rbind.data.frame, models_cc(data = db3_sqrt$data) )
res3_sqrt$width_ci = res3_sqrt$upper_ci  - res3_sqrt$lower_ci 
knitr::kable(res3_sqrt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm width_ci
0 13.96743 12.76704 15.16782 TRUE a1 2.400777
0 14.99524 13.85328 16.13719 TRUE a2 2.283911

Comparing groups when using the optimal allocations

res3_opt = do.call(rbind.data.frame, models_cc(data = db3_opt$data) )
res3_opt$width_ci = res3_opt$upper_ci  - res3_opt$lower_ci 
knitr::kable(res3_opt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm width_ci
0 13.5188 12.50096 14.53664 TRUE a1 2.035677
0 15.2676 14.07628 16.45892 TRUE a2 2.382642

2.3.2 Trial with unequal allocation rates for for periods 1 and 3

Suppose now that the size of the periods are:

# N = 80
N1 = round(N/3)
N2 = round(2*(N-N1)/3)
c(N1,N2,N-N1-N2) 
#> [1] 27 35 18
db3_one=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="one")
db3_sqrt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="sqrt")
db3_opt=sim_designs(r1=N1/N,r2=N2/N,mu0=mean_control,mu1=mean_arm1,mu2=mean_arm2,N=N,alloc="opt")

plot_trial(db3_opt$data$treatment) 
Design 3: three-period design (r1<r3).

Design 3: three-period design (r1<r3).


# sample sizes
db3_one$ss
#>      [,1] [,2] [,3]
#> [1,]    0   12    9
#> [2,]   14   12    0
#> [3,]   14   12    9
db3_sqrt$ss
#>      [,1] [,2] [,3]
#> [1,]    0   10    9
#> [2,]   14   10    0
#> [3,]   14   14    9
db3_opt$ss
#>      [,1] [,2] [,3]
#> [1,]    0   13    9
#> [2,]   14    7    0
#> [3,]   14   15    9

db3_one_ss <- data.frame(arms=c("A1","A2","C"),db3_one$ss, c(sum(db3_one$ss[1,]),sum(db3_one$ss[2,]),sum(db3_one$ss[3,])))
db3_sqrt_ss <- data.frame(arms=c("A1","A2","C"), db3_sqrt$ss, c(sum(db3_sqrt$ss[1,]),sum(db3_sqrt$ss[2,]),sum(db3_sqrt$ss[3,])))
db3_opt_ss <- data.frame(arms=c("A1","A2","C"), db3_opt$ss, c(sum(db3_opt$ss[1,]),sum(db3_opt$ss[2,]),sum(db3_opt$ss[3,])))

The sample sizes per arm and period according to the allocation strategies are the following:

knitr::kable(db3_one_ss, format = "markdown", caption = c("Sample sizes per period and arm (1:1)"), col.names = c("Arms", "Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (1:1)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 12 9 21
A2 14 12 0 26
C 14 12 9 35
knitr::kable(db3_sqrt_ss, format = "markdown", caption = c("Sample sizes per period and arm (sqrt(k)-rule)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (sqrt(k)-rule)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 10 9 19
A2 14 10 0 24
C 14 14 9 37
knitr::kable(db3_opt_ss, format = "markdown", caption = c("Sample sizes per period and arm (optimal allocations)"), col.names = c("Arms","Period 1","Period 2","Period 3", "Total per arm"))
Sample sizes per period and arm (optimal allocations)
Arms Period 1 Period 2 Period 3 Total per arm
A1 0 13 9 22
A2 14 7 0 21
C 14 15 9 38

Comparing groups when using 1:1 allocation

res3_one = do.call(rbind.data.frame, models_cc(data = db3_one$data) )
res3_one$width_ci = res3_one$upper_ci  - res3_one$lower_ci 
knitr::kable(res3_one, format = "markdown") 
p_val treat_effect lower_ci upper_ci reject_h0 arm width_ci
0 14.13156 12.86774 15.39537 TRUE a1 2.527631
0 15.69270 14.19890 17.18649 TRUE a2 2.987591

Comparing groups when using \(\sqrt(k)\)-allocation

res3_sqrt = do.call(rbind.data.frame, models_cc(data = db3_sqrt$data) )
res3_sqrt$width_ci = res3_sqrt$upper_ci  - res3_sqrt$lower_ci 
knitr::kable(res3_sqrt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm width_ci
0 14.41764 13.25114 15.58413 TRUE a1 2.332989
0 16.77700 15.51546 18.03853 TRUE a2 2.523070

Comparing groups when using the optimal allocations

res3_opt = do.call(rbind.data.frame, models_cc(data = db3_opt$data) )
res3_opt$width_ci = res3_opt$upper_ci  - res3_opt$lower_ci 
knitr::kable(res3_opt, format = "markdown")
p_val treat_effect lower_ci upper_ci reject_h0 arm width_ci
0 12.84280 11.52895 14.15664 TRUE a1 2.627691
0 15.98529 14.81737 17.15321 TRUE a2 2.335841

3 Simulations

load("C:/Users/mbofi/Dropbox/CeMSIIS/GitHub/Allocation/case-study/results/simstudy_results.RData")
df_res$design = ifelse(as.numeric(df_res$r1)+as.numeric(df_res$r2)==1,"2-period", "3-period")

To compare power and type 1 error of the different designs, we undertake a simulation study to evaluate the performance when using 1:1 allocations. For comparative purposes, we also consider a total sample size for the trial equal to XX

res_report_H1 <- df_res %>% filter(H0=="FALSE") %>% select(minrt,rt_a1,rt_a2,r1,r2,alloc,design)
knitr::kable(res_report_H1, format = "markdown", caption = c("Power comparisons"), col.names=c("Min Power", "Power A1", "Power A2", "r1",   "r2",   "Allocation",   "Design"))
Power comparisons
Min Power Power A1 Power A2 r1 r2 Allocation Design
0.90015 0.93188 0.90015 0.3375 0.4375 one 3-period
0.91773 0.91773 0.92704 0.3375 0.4375 opt 3-period
0.91739 0.94009 0.91739 0.3375 0.4375 sqrt 3-period
0.40323 0.71062 0.40323 0.25 0.75 one 2-period
0.48907 0.6354 0.48907 0.25 0.75 opt 2-period
0.40952 0.70559 0.40952 0.25 0.75 sqrt 2-period
res_report_H0 <- df_res %>% filter(H0=="TRUE") %>% select(minrt,rt_a1,rt_a2,r1,r2,alloc,design)
knitr::kable(res_report_H0, format = "markdown", caption = c("Type 1 error rate"), col.names=c("Min T1E", "T1E A1", "T1E A2",   "r1",   "r2",   "Allocation",   "Design"))
Type 1 error rate
Min T1E T1E A1 T1E A2 r1 r2 Allocation Design
0.0252 0.0252 0.02542 0.3375 0.4375 one 3-period
0.0245 0.02456 0.0245 0.3375 0.4375 opt 3-period
0.02396 0.02483 0.02396 0.3375 0.4375 sqrt 3-period
0.02464 0.02464 0.02515 0.25 0.75 one 2-period
0.02139 0.02139 0.02433 0.25 0.75 opt 2-period
0.02425 0.02425 0.02471 0.25 0.75 sqrt 2-period
 

Center for Medical Statistics, Informatics and Intelligent Systems, Medical University of Vienna.

[Klassifizierung: vertraulich]

Marta Bofill Roig

marta.bofillroig@meduniwien.ac.at

and Martin Posch

martin.posch@meduniwien.ac.at